Developer CD Series 1994…tember: Reference Library/Dev.CD Sep 94.toast/Periodicals/develop/develop Issue 11/develop 11 code/The NetWork Project/Examples (Sources)/RemoteJob.p

Text File | 1992-07-15 | 16.6 KB | 610 lines | [TEXT/MPS ]

{
    File:        RemoteJob.p

    Contains:    remote launching example

    Written by:    G. Sawitzki, StatLab Heidelberg

    Copyright:    © 1989-1991 The NetWork Project, StatLab Heidelberg.
                © Copyright 1989-1991 Günther Sawitzki, Heidelberg. All rights reserved.
    Change History (most recent first):

        <9+>      8/2/91    gs        remove NLExit, ExitNetWork

    To Do:
}


program RemoteJob; {0.1d5}

uses
    Errors,
    Types, QuickDraw, Menus,
    Memory,
    Fonts,Windows,TextEdit,Dialogs,
    OsUtils,Files,
    Events,Desk,
    NetWork, NetWorkLookup,Traps,
    ObjIntf,SchedulerUnit,PasLibIntf;

{-----------------------------------------------------------------------}
{remote launching example. This can be used to do a remote launch of
pre-NetWork programs. A simple use would be to have a remote MPW
cooperating on a build.

The sending part looks for a file named remote.job in the system folder.
If the file exists, its data fork is transferred according to the user
selected settings.

Upon receipt of a message, the receiving part stores the file as file
UserStartUp•Remote.Job in the system folder, and tries to launch the
proper target, eg. MPW.

To use it, place a copy of MPW and a suitable startup file in the
NetWork folder on the receiving machine.

• under construction • Alpha release notes:

spare does a lot of debugging. should be used only with source in hand.

To do:
Which of the ping games should be allowed ?
Provide prototype for collision detection,improper format handling.
File error handling.
System 7 support for reduced MPW shell (to be introduced with ETO 3).

Done:

0.1d4    ##
0.1d3    adapted to event-based scheduler
0.1d2    default received file type to TEXT
}

{=============================================================================}
{    our message header format    }

const cFormatVersion='VS 1';    {good habit: keep a version stamp around while
                                you are experimenting}

type
    tHeaderPtr=^tHeader;
    tHeader=record
        idStamp:longint;
        signature:longint;    {whom shall we activate ?}
        whereMode:integer;    {code for determining the target system.
                            see MsgEvaluation}
    end;

var sendHeader    :tHeader;        {we keep one copy around to define defaults}

{=============================================================================}
{    our message handlers. We will work with static message handler, so we
instantiate one of each and keep it around all the time}

{-----------------------------------------------------------------------------}
{    sending part: generate a task if a command is given or a commenand file
    is around    }

type
    tRemoteGenerator= Object(tTaskGenerator)
        function tRemoteGenerator.newTask(var msg:MsgPtr):boolean; override;
    end;

var RemoteGenerator    : tRemoteGenerator;

{-----------------------------------------------------------------------------}
{    recipients part: a message is considered usable if the header has the
    correct format id. MsgEvaluation stores the information to a file, and
    sends an (empty) message to launch the recipient.}

type
    tRemoteHandler = Object(tTaskhandler)
        FormatVersion:longint;                        {we can only use messages of this version}
        procedure tRemoteHandler.init; override;    {sets FormatVersion to cFormatVersion}
        function tRemoteHandler.MsgUsable(var msg:msgPtr):boolean; override;
        procedure tRemoteHandler.MsgEvaluation(var msg:msgPtr); override;
    end;

var RemoteHandler : tRemoteHandler;


{=============================================================================}
{    global constants and variables    }

const
    cMaxJobFileSize        = 8*1024;    {to improve: work with any file sizes}

    {default file names}
    cJobFileToSend        ='Remote.Job';
    cJobFileReceived    ='UserStartUp•Remote.Job';
var
    JobFileToSend,
    JobFileReceived        : str255;

    done, front            : boolean;
    mode                : integer;
    gSleep                : longint;

    gTextValid            : boolean;
    gTextToSend         : Str255;
        {if gTextValid is true, gTextToSend holds a text to be transmitted}


    {=============================================================================}
    {    Application layer    }

    {-----------------------------------------------------------------------------}
    {    File access routines    }



function CheckStatus(whichFile:str255):osErr;

        {Return NoErr if a file named whichFile exists and is ready for sending.
        This is used to check for the existence of cJobFileToSend.
        To do: it should guarantee that the file is not open for write
        in order to guarantee that writing of the job file is finished. }

var myfinfo:Finfo;
begin
    CheckStatus:=GetFInfo(whichFile,0,myfinfo);
end;


procedure ReadJobFile(whichFile:str255;var filesize:longint;var where:ptr);

        {Open a file and read the contents to the buffer indicated by
        where. Return the number of bytes read. Delete the file.}

VAR
    InputFile: FILE;
    myerr:osErr;
begin
    if spare then debugstr(concat('Start ReadJobFile ',whichfile,' Type g to continue.'));
    filesize:=0;
    reset(InputFile, whichfile);
    if (ioresult=0) & (where<>nil) then
    begin
        filesize:= byteread(InputFile, where^, GetPtrSize(where));
        myErr:=ioResult;
        if spare & (myerr<>noErr) then debugstr('error on read');
        close(inputfile);
        PLPurge(JobFileToSend);
    END;
end;


procedure WriteJobFile(whichFile:str255;filesize:longint; where:ptr);

    {Create a file and write the contents to the buffer indicated by
    where. Set type and crator as for an MPW text file. close the file.}

const cDefaultVolRef=0;
VAR
    OutputFile: FILE;
    myErr:Oserr;
    fndrinfo:Finfo;
begin
    if spare then debugstr(concat('Start WriteJobFile: ',whichfile,' Type g to continue.'));
    rewrite(OutputFile, whichfile);
    if ioresult=0 then {to improve:handle multiple files}
    begin
        filesize:=bytewrite(OutputFile, where^, filesize);
        close(OutputFile);
        if getfinfo(JobFileReceived, cDefaultVolRef, fndrinfo)=NoErr then
        begin
            fndrinfo.fdtype := 'TEXT';    {clame it is from MPW, as default}
            fndrinfo.fdCreator := 'MPS ';
            if  Setfinfo(JobFileReceived, cDefaultVolRef, fndrinfo) <> noErr then;
        END;

    END;
end;


{=============================================================================}
{    NetWork specific part of layer    }


{-----------------------------------------------------------------------------}
const    {several modes to identify the machine on which a process shall be launched.
    -- to experiment with }

    LocalMode    =1;    {launch on local machine}
    RandomMode    =2;    {launch on a random machine}
    NextMode    =3;    {launch on the next machine}
    BroadcastMode=4;{launch on all machines}


function newAddr(var addr:longint;mode:integer):boolean;
begin    newAddr:=true;{default}
    case Mode of
        1 : addr := 0; { local }
        2 : begin addr := NlRandom; if addr=0 then newAddr:=false;end;
        3 : begin
            if addr<0 then addr:=NLRandom else
            addr := NlNext (addr);
            if addr=0 then newAddr:=false;
        end;
        4 : addr := -1; { broadcast }
    end;
end;


{=============================================================================}
{    message handler implementation    }

{-----------------------------------------------------------------------------}
{    recipients part    }

var     MessageToPass    :msgRec;    {allocate static space to avoid heap fragmentation}


procedure tRemoteHandler.init; override;    {sets FormatVersion to cFormatVersion}
begin
    inherited init;
    FormatVersion:=longint(cFormatVersion);
end;

function tRemoteHandler.MsgUsable(var msg:msgPtr):boolean; override;
var oksofar:boolean;
begin
    if spare then debugstr('RemotJob MsgUsable. Type g to continue.');
    with  tHeaderPtr(msg^.MsgPrioPtr)^ do
    oksofar:=(idStamp=FormatVersion);    {have we got the correct version?}
    if oksofar then with msg^ do
         MsgCorePtr:=NewCorePtr(MsgCoreSize);        {to do: check size}
    stamp(msg);
    MsgUsable:=oksofar;
end;


procedure tRemoteHandler.MsgEvaluation(var msg:msgPtr);override;
var NewMsg : MsgPtr;
begin
    if spare then debugstr('RemotJob MsgEvaluation. Type g to continue.');

    {store the information as a file}
    with msg^do
    if (MsgCoreSize>0) & (MsgCorePtr<>nil) then writeJobFile(JobFileReceived,MsgCoreSize,MsgCorePtr);

    {now find the adressee}

    with tHeaderPtr(msg^.MsgPrioPtr)^,MessageToPass do
    begin
        {determine whom we should we call, using the header information}
        MsgDest.p := signature;
        if NewAddr(MsgDest.a, whereMode ) then begin

            MsgReply:=MsgSource; {we are just the mail. all results & complaints to sender please}

            NewMsg:=@MessageToPass;
            {all other fields 0 -- does not work when compiled with -u option}
            NetWorkScheduler.SendMessage(NewMsg);     {launch it}
        end else if spare then debugstr('no partner.  Type g to continue.');
        {leave all error handling to the scheduler}
    end;
    {Scheduler.HandleError(pUndefined,DisposMsg(msg));}
end;


{-----------------------------------------------------------------------------}
{    sending part: we generate a task    }


function tRemoteGenerator.newTask(var msg:MsgPtr):boolean; override;
var
    oktosend:boolean;
begin
    if spare then debugstr('tRemoteGenerator.newTask start;g');

    if not(gTextValid) & (CheckStatus(JobFileToSend)<>noErr) then okToSend:=false
    else begin
        with msg^ do
        begin
            okToSend:= NewAddr(MsgDest.a,mode);
            if okToSend then begin
                if gTextValid then begin {messages on the fly are sent first}
                    MsgCoreSize    :=length(gTextToSend);
                    MsgCorePtr    :=NewCorePtr(MsgCoreSize);
                    BlockMove(@gTextToSend[1],MsgCorePtr,MsgCoreSize);
                    gTextValid    :=false;
                end else begin {no message on the fly, hence it must be a file}
                    MsgCoreSize    :=cMaxJobFileSize;        {to improve: take real file size}
                    MsgCorePtr    :=NewCorePtr(MsgCoreSize);
                    ReadJobFile(JobFileToSend,MsgCoreSize,MsgCorePtr);
                end;
                if MsgCorePtr=nil then okToSend:=false
                else begin
                    MsgPrioSize    :=sizeof(SendHeader);
                    MsgPrioPtr    :=NewPrioPtr(MsgPrioSize);
                    if MsgPrioPtr=nil then okToSend:=false {overrun or out of memory}
                    else
                    tHeaderPtr(MsgPrioPtr)^:=SendHeader;
                end;
            end;
        end;
        if okToSend then begin
            Stamp(msg);
            NewTask:=true;
            if spare then debugstr('tRemoteGenerator.newTask ok;g');
        end else NewTask:=false;
    end;
end;

    {=============================================================================}
    {    general routines    }


PROCEDURE InitToolBox;
VAR
    i : integer;
    p : GrafPtr;
    m : MenuHandle;

BEGIN
    MaxApplZone;
    FOR i := 1 TO 10 DO
    MoreMasters;
    InitGraf(@thePort);                {initialize QuickDraw}
    InitFonts;                           {initialize Font Manager}
    InitWindows;                       {initialize Window Manager}
    InitMenus;                           {initialize Menu Manager}
    TEInit;                            {initialize TextEdit}
    InitDialogs(NIL);                   {initialize Dialog Manager}
    InitCursor;                        {call QuickDraw to make cursor (pointer) an arrow}

    m := GetMenu (256);
    AddResMenu (m, 'DRVR');
    InsertMenu (m, 0);
    m := GetMenu (257); InsertMenu (m, 0);
    m := GetMenu (258); InsertMenu (m, 0);
    DrawMenuBar;

END;


{    Handle the about alert. Stolen from and © by J. Lindenberg, Karlsruhe 1989    }

{and here again we do the job the toolbox programmers should have done…}

function ModalFilter (dialog : DialogPtr; var ev : EventRecord;
var itemHit : integer) : boolean;
begin
    ModalFilter := false;
    if ev.what = keydown then
    case BAnd (ev.message, 255) of
        ord ('Q'): if (BAnd (ev.modifiers, cmdKey) <> 0) then begin
            itemhit := cancel; ModalFilter := true;
        end;
        ord ('.'): begin itemhit := cancel; ModalFilter := true; end;
        13 : begin itemhit := OK; modalfilter := true; end;
    end;
end;


procedure About;
begin
    if Alert (256, @ModalFilter) = Ok then;
end;


{=============================================================================}
{    set signature and names of task files    }

procedure SetNames;
const     cSignature=3;
    cJobFileToSend=6;
    cJobFileReceived=8;
var d : DialogPtr; n : integer; s : Str255;

procedure SetMyDialog(item:integer;info:str255);
var t : integer;h : Handle; box : Rect;
begin
    GetDItem (d, item, t, h, box);
    SetIText (h, info);
end;

function GetMyDialog(item:integer):str255;
var t : integer;h : Handle; box : Rect;
begin
    GetDItem (d, item, t, h, box);
    GetIText (h, GetMyDialog);
end;

begin
    d := GetNewDialog (258, nil, WindowPtr (-1));

    SetMyDialog(cJobFileToSend,JobFileToSend);
    SetMyDialog(cJobFileReceived,JobFileReceived);

    s := '????'; BlockMove (@SendHeader.signature, @s[1], 4);
    SetMyDialog(cSignature,s);
    SelIText (d, cSignature, 0, 32767);

    repeat
        ModalDialog (nil, n);
        s:=GetMyDialog (cSignature);
    until (n = cancel) | ((n=ok) & (length (s) = 4));

    if n = Ok then begin
        {if it is ok, s contains the recent signature}
        BlockMove (@s[1], @SendHeader.signature, 4);
        JobFileToSend:=GetMyDialog (cJobFileToSend);
        JobFileReceived:=GetMyDialog (cJobFileReceived );
    end;
    DisposDialog (d);
end;


procedure SendOnTheFly;
    {get a command by dialog, create a message and send it.
    This is an example of forcing a new task generation.}

var d : DialogPtr; n, t : integer;  h : Handle; box : Rect;
    tempAddr:MsgAddr;
begin
    d := GetNewDialog (259, nil, WindowPtr (-1));

    repeat
        ModalDialog (nil, n);
    until (n = ok) | (n=cancel);
    if n = Ok then begin

        GetDItem (d, 3, t, h, box);
        GetIText (h, gTextToSend);     {get the text to our buffer}
        gTextValid :=true;            {yes, the information is valid}

        tempAddr    := NetWorkScheduler.PrevDest;
        NetWorkScheduler.DoNewTask(tempAddr,NetWorkScheduler.MyTransport);
                                    {get the scheduler to fill all defaults, and call
                                    newTask}
    end;
    DisposDialog (d);
end;


{=============================================================================}
{    menu handling    }

procedure DoMenu (menu : Point);
var  s : Str255;
begin
    case menu.v of
        256 : { apple menu }
        if menu.h = 1 then About
        else begin
            GetItem (GetMHandle (256), menu.h, s);
            CheckError ('OpenDeskAcc', OpenDeskAcc (s));
        end;
        257 : {file and commands}
        case menu.h of
            1 : SetNames;
            3 : SendOnTheFly;
            4 : done := true;
        end;
        258 : {sendmode}
        begin
            CheckItem (GetMHandle (258), mode, false);    {uncheck old}
            mode := menu.h;
            CheckItem (GetMHandle (258), mode, true);     {check new}
        end;
    end;
    HiliteMenu (0);
end;




{=============================================================================}
{    main event    }

procedure HandleEvents;
var w : windowPtr;
    ev : EventRecord;
begin
    if WaitNextEvent (EveryEvent, ev, gSleep, nil) then
    case ev.what of
        mouseDown : case FindWindow (ev.where, w) of
            inMenuBar :     DoMenu (Point (MenuSelect (ev.where)));
            inSysWindow :    SystemClick (ev,w);
        end;
        keyDown : if BAnd (ev.modifiers, cmdKey) <> 0 then
        DoMenu (Point (MenuKey (chr (BAnd (ev.message, 255)))));
        {*******************}
        NetWorkEvt: NetWorkScheduler.HandleMsg(MsgPtr(ev.message));
        {*******************}
        otherwise  begin
        end;{otherwise}
    end {case}
    else begin
        NetWorkScheduler.PeriodicTask;
        If NlTask<>NoErr then ProgramBreak('Error in NlTask');
    end;
end;


procedure initdefaults;
begin
    if spare then debugstr('RemoteJob initdefaults. Type g to continue.');
    done    := false;
    mode    :=NextMode;

    JobFileToSend    :=cJobFileToSend;
    JobFileReceived    :=cJobFileReceived;
    gTextValid    :=false;
    gTextToSend    :='';
    with sendHeader do
    begin
        idStamp:=longint(cFormatVersion);    {this is version 1 format}
        signature:=longint('MPS ');    {whom shall we activate ? default: MPW}
        whereMode:=LocalMode;        {the recipient should launch it locally}
    end;
end;


{run HandleEvents a small number of times to get the screen etc set up}
procedure initialwakeup;
var count:integer;
begin
    gSleep := 0;
    for count:=1 to 6 do begin
        NetWorkScheduler.Receiving:=true;
        HandleEvents;
    end;
end;

{find requested sleep value. Polling all clients is a bad strategy here -
in general, you will not know at programming time who might be active.
However Apple recommends this poor strategy. So we follow it for this example}

procedure getSleep;
var tempsleep:longint;
begin
    gSleep:=10;{my default maximum sleep value}
    tempSleep:=NetWorkScheduler.GetSleep;
    if tempSleep<gSleep then gSleep:=tempSleep;
    tempSleep:=NLGetSleep;
    if tempSleep<gSleep then gSleep:=tempSleep;
    if gSleep<0 then gSleep:=0;
end;

{=============================================================================}
{        }

begin
    InitToolBox;
    InitDefaults;

    if InitNetwork(NetWorkEvt)<>NoErr then halt;
    if NlInit<>noErr then halt;

    New(NetWorkScheduler);            {Create and Install the scheduler}
    NetWorkScheduler.Init;

    new(remoteHandler);     {create a remoteHandler and introduce it to the scheduler}
    NetWorkScheduler.InitTaskHandler(remoteHandler);

    if master then begin    {create a remoteGenerator and introduce it to the scheduler}
        new(remoteGenerator);
        NetWorkScheduler.InitTaskGenerator(remoteGenerator);
    end;

    initialwakeup;        {run HandleEvents a small number of times to get the screen etc set up}
    gSleep:=60;

    repeat
        NetWorkScheduler.Receiving:=true;
        getSleep;
        HandleEvents;
        if (not master) & (NetWorkScheduler.taskhandler.NrPendingMessages=0)
        then done:=true;
        NetWorkScheduler.Sending:=NetWorkScheduler.taskgenerator<>nil;    {even if there was nothing now…}
    until done;

    NetWorkScheduler.Free;
    {if NLExit<>noErr then halt;
    if ExitNetWork <> NoErr then halt;}

end.